unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons, ComCtrls, Spin;

type
  TForm1 = class(TForm)
    Image1: TImage;
    UpdateNutrient: TBitBtn;
    Timer1: TTimer;
    GroupBox1: TGroupBox;
    max: TSpinEdit;
    min: TSpinEdit;
    Label5: TLabel;
    Label6: TLabel;
    GroupBox2: TGroupBox;
    RSun: TRadioButton;
    RMo: TRadioButton;
    GroupBox3: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    Panel1: TPanel;
    Label4: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    GroupBox5: TGroupBox;
    procedure InitialNClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure VisualizeBtnClick(Sender: TObject);
    procedure NBarChange(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure UpdateNutrientClick(Sender: TObject);
    procedure SolveNDiffClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure WaterFlowCheckClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

Type
  TRGB32 = packed record
    B, G, R, A: Byte;
  end;
  TRGB32Array = packed array[0..MaxInt div SizeOf(TRGB32)-1] of TRGB32;
  PRGB32Array = ^TRGB32Array;


  TRGB = record
    R, G, B : Byte;
  end;

var
  Form1: TForm1;
//เงา
  inn,Shadow,N,Nnew, Root : array[0..1285,0..813] of Single;  // Nutrient Concentration 1285x813

  //---colormap from Blue to Red
  ColorMap : array[0..255] of TRGB;

  MStart, MEnd : TPoint;

  SystemOK : Boolean = False;

  WaterFlowFlag : Integer = 1;

  timeStep : integer = 0;
   clickImage1:integer=0;
    EndX : integer;
  EndY : integer;
  colorLine:TColor=clRed;
  tmax:real=0;
implementation

{$R *.dfm}

procedure TForm1.InitialNClick(Sender: TObject);
var
    i, j : integer;
    Nconc : Real;
begin
   // Nconc := NBar.Position/100;
    For j:=0 to 813 Do
    For i:=0 to 1285 Do
    begin
         N[i,j] := Nconc + Random(100)/1000;
    end;
end;

procedure TForm1.FormShow(Sender: TObject);
var
      i : integer;
begin
    //---Blue(0,0,255) --> Red(255,0,0)
    //color bg
    Image1.Canvas.Brush.Color := clBlack;
      Image1.Canvas.Pen.Color := clBlack;
    image1.Canvas.Rectangle(0,0,1285,813);
      For i:=0 to 255 Do
      begin
           {
            Colormap[i].R := i;
            Colormap[i].G := 0;
            Colormap[i].B := 255-i;
            }
             Colormap[i].R := i;
            Colormap[i].G := i;
            Colormap[i].B := i;
      end;
end;

procedure TForm1.VisualizeBtnClick(Sender: TObject);
{

//----- Old Slowly Method by PutPixel Method
var
      i, j : integer;
      NIndex : integer;
begin
      For j:=1 to 813 Do
      For i:=1 to 1285 Do
      begin
          NIndex := Round(255*(N[i,j]-0)/(1-0));
          If Root[i,j] = 1 Then
            Image1.Canvas.Pixels[i,j] := clWhite
          Else
            Image1.Canvas.Pixels[i,j] := RGB(Colormap[NIndex].R,Colormap[NIndex].G,Colormap[NIndex].B);
      end;// for i,j
      Image1.Refresh;
end;
}

//---- New Faster Method using Scanline Method
var 
  i,j  : Integer;
  Line : PRGB32Array;
  NIndex : integer;
  num : Double;
  num2 :Integer;
begin

  with Image1.Picture.Bitmap do
  begin
    PixelFormat := pf32bit;
    Width := Image1.Width;
    Height := Image1.Height;
    for j := 0 to Height-1 do
    begin
      Line := Scanline[j];
      for i := 0 to Width-1 do
      begin
        If Root[i,j] = 1 then
        begin
            Line[i].B := 255;
            Line[i].G := 255;
            Line[i].R := 255;
            Line[i].A := 255;
        end
        else
        begin
			
            NIndex := Round(1020*(N[i,j]-0)/(100-0));
			If ( NIndex <=255) then
			begin
            Line[i].R := Colormap[0].R;
            Line[i].G := Colormap[NIndex].G;
            Line[i].B := Colormap[255].B;
            Line[i].A := 255;
			end
			Else 
			If ( NIndex <=510) then
			begin
            Line[i].R := Colormap[0].R;
            Line[i].G := Colormap[255].G;
            Line[i].B := Colormap[510-NIndex].B;
            Line[i].A := 255;
			end
			Else 
			If ( NIndex <=765) then
			begin
			
            Line[i].R := Colormap[NIndex-510].R;
            Line[i].G := Colormap[255].G;
            Line[i].B := Colormap[0].B;
            Line[i].A := 255;
			end
			Else
			begin
            Line[i].R := Colormap[255].R;
            Line[i].G := Colormap[1020-NIndex].G;
            Line[i].B := Colormap[0].B;
            Line[i].A := 255;
			
			End;
        end;

      end;
    end;
  end;
  Image1.Invalidate;



end;

procedure TForm1.NBarChange(Sender: TObject);
begin
        SystemOK := False;
        InitialNClick(Sender);
        VisualizeBtnClick(Sender);
         Image1.Canvas.Brush.Color := clRed;
        Image1.Canvas.Pen.Color := clRed;
        
        Image1.Canvas.Pen.Width := 3;
        Image1.Canvas.MoveTo(450, 0);
        Image1.Canvas.LineTo(450,493);

end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
      MStart.X := X;
      MStart.Y := Y;
      SystemOK := False;
      clickImage1:=1;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    clickImage1:=0;
    MEnd.X := X;
    MEnd.Y := Y;
   // Image1.Canvas.cl
    Image1.Canvas.Brush.Color := colorLine;
    Image1.Canvas.Pen.Color := colorLine;
    Image1.Canvas.Pen.Width := 10;

    Image1.Canvas.MoveTo(MStart.X, MStart.Y);
    Image1.Canvas.LineTo(MEnd.X, MEnd.Y);
    Image1.Canvas.Brush.Color := clWhite;
    //Image1.Canvas.Polygon([Point(MEnd.X, MStart.Y),Point(MEnd.X, MEnd.Y),Point(MStart.X, MEnd.Y),Point(MStart.X, MStart.Y)]);
	if MStart.X<642 then
	Image1.Canvas.Polygon([Point(642-MStart.X, MStart.Y),Point(642-MEnd.X, MEnd.Y),Point(MEnd.X, MEnd.Y),Point(MStart.X, MStart.Y)])
	else
	Image1.Canvas.Polygon([Point(1285-(MStart.X-642), MStart.Y),Point(1285-(MEnd.X-642), MEnd.Y),Point(MEnd.X, MEnd.Y),Point(MStart.X, MStart.Y)])  ;
    Image1.Refresh;
end;

procedure TForm1.UpdateNutrientClick(Sender: TObject);
var
    i, j ,num: integer;
begin
//inn
    For j:=1 to 812 Do
    For i:=1 to 1284 Do
    begin
     If Image1.Canvas.Pixels[i,j] = clBlack Then
		begin
			inn[i,j] := 0.25;
		end
     else	If Image1.Canvas.Pixels[i,j] = clRed Then
		begin
			inn[i,j] := 0.2;
		end
	 else	If Image1.Canvas.Pixels[i,j] = clGreen Then
		begin
			inn[i,j] := 0.15;
		end
	else	If Image1.Canvas.Pixels[i,j] = clWhite then
  		begin
			inn[i,j] :=0.25;
		end
	else	
		begin
			inn[i,j] :=0.1;
		end
	end;
  
//Shadow	
num:=9999;
	
	For i:=1 to 1284 Do
    For j:=1 to 812 Do
    
    begin
     If Image1.Canvas.Pixels[i,j] = clBlack Then
	  	begin
			  N[i,j] := 100;
			  Shadow[i,j]:=100;
			  
		  end
	    else
      	begin
		    Shadow[i,j]:=num;
			N[i,j] := 0;
		    

	      end
	  End;
    SystemOK := True;

end;

procedure TForm1.SolveNDiffClick(Sender: TObject);
var
    i, j,day : integer;
    Dx, Dy, Dt, s, q, Vy : Single;
begin
{ 
 Dx := 0.1;
    Dy := 0.2;
    Dt := 1.0;
    s  := 1.0;
    q  := 0.01;
    Vy := 0.01;
}	
Dx := 0.1;
    Dy := 0.2;
	 Dt := 1.0;
	 s  := 1.0;
	 q  := 0.01;
	 Vy := 0.01;
{
    For i:=0 to 1285 Do
    begin 
        N[i,1] := s;
        N[i,2] := s;
        N[i,3] := s;
    end;
}
//day
	If RSun.Checked = true then
		day:=1
	Else day:=0;
    For j:=1 to 812 Do
    For i:=1 to 1284 Do
    Begin
         {
		 NNew[i,j] := N[i,j] + (Dt*Dx)*(N[i-1,j] - 2*N[i,j] + N[i+1,j])
                             + (Dt*Dy)*(N[i,j-1] - 2*N[i,j] + N[i,j+1])
                             //- Root[i,j]*q*Dt
							 ;
		}
{		 NNew[i,j] := N[i,j] + 1*(0.3)*(N[i-1,j] - 2*N[i,j] + N[i+1,j])
                             + (1)*5*(N[i,j-1] - 2*N[i,j] + N[i,j+1])
                             //- Root[i,j]*q*Dt
							 ;               }
    NNew[i,j] := N[i,j] +1*( inn[i,j])*(N[i-1,j]+N[i,j-1]+ N[i,j+1] - 4*N[i,j] + N[i+1,j])
                             //+ (1)*0.3*( - 2*N[i,j] )
                             //- Root[i,j]*q*Dt
							 ;

                            // + WaterFlowFlag*Vy*(N[i,j-1] - N[i,j]);

         If NNew[i,j] < 0 then NNew[i,j] := 0
		 else If NNew[i,j] > 100 then NNew[i,j] := 100;

    End;//for i,j

 //---left boundary -------
   { For j:=1 to 812 Do
    For i:=1 to 1 Do
    Begin
         NNew[i,j] := N[i,j] + (Dt*Dx)*( - 2*N[i,j] + 2*N[i+1,j])
                             + (Dt*Dy)*(N[i,j-1] - 2*N[i,j] + N[i,j+1])
                             //- Root[i,j]*q*Dt
							 ;

                          //   + WaterFlowFlag*Vy*(N[i,j-1] - N[i,j]);

         If NNew[i,j] < 0 then NNew[i,j] := 0;
    End;//for i,j

 
 //---right boundary -------
    For j:=1 to 812 Do
    For i:=1284 to 1284 Do
    Begin
         NNew[i,j] := N[i,j] +(Dt*Dx)*(2*N[i-1,j] - 2*N[i,j])
                             +(Dt*Dy)*(N[i,j-1] - 2*N[i,j] + N[i,j+1])
                             //- Root[i,j]*q*Dt
							 ;

                            // + WaterFlowFlag*Vy*(N[i,j-1] - N[i,j]);

         If NNew[i,j] < 0 then NNew[i,j] := 0;
    End;//for i,j
}
 //---bottom boundary -------
    
    For i:=1 to 1285Do
	For j:=1 to 812 Do
    Begin
	if 	(Shadow[i,j] = 9999) then
      begin
	  if (RSun.Checked= true) then
	  Break
	  end
	else 	NNew[i,j]:=day*Shadow[i,j];

       //  NNew[i,j] := 1000;
                             //- Root[i,j]*q*Dt
							 ;
                             //+ WaterFlowFlag*Vy*(N[i,j-1] - N[i,j]);

         If NNew[i,j] < 0 then NNew[i,j] := 0;
    End;//for i,j


    //Visualization 
	
    VisualizeBtnClick(Sender);

    For j:=0 to 813 Do
    For i:=0 to 1285 Do
    Begin
         N[i,j] := NNew[i,j];
         If N[i,j] > tmax then tmax:=NNew[i,j];
	        
    End;//for i,j

       Label3.Caption := 'Tmax = ' + FloatToStr(tmax) ;
		Label3.Refresh;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
      If SystemOK Then
      begin
         SolveNDiffClick(Sender);
         Label2.Caption := 'Time Step = ' + inttostr(TimeStep);
         inc(timeStep);
      end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);

Var
tem:integer;
begin
  if RadioButton1.Checked = true  then
      colorLine:=clRed
      ELSE if RadioButton2.Checked = true then
        colorLine:=clBlue
        else
        colorLine:=clGreen;
             Image1.Canvas.Brush.Color := colorLine;
        Image1.Canvas.Pen.Color := colorLine;
        Image1.Canvas.Pen.Width := 10;
  if clickImage1 = 1  then
      begin
      Image1.Canvas.Brush.Color := clBlack;
      Image1.Canvas.Pen.Color := clBlack;
      Image1.Canvas.MoveTo(MStart.X, MStart.Y);
      Image1.Canvas.LineTo(EndX,EndY);
	  if MStart.X < 642 then
	  begin
      Image1.Canvas.MoveTo(642-MStart.X, MStart.Y);
      Image1.Canvas.LineTo(642-EndX,EndY);

      Image1.Canvas.Brush.Color := colorLine;
      Image1.Canvas.Pen.Color := colorLine;
      Image1.Canvas.MoveTo(MStart.X, MStart.Y);
      Image1.Canvas.LineTo(X,Y);
      Image1.Canvas.MoveTo(642-MStart.X, MStart.Y);
      Image1.Canvas.LineTo((642-X),Y);
	  end
	  else
	  begin
	  Image1.Canvas.MoveTo(1285-(MStart.X-642), MStart.Y);
      Image1.Canvas.LineTo(1285-(EndX-642),EndY);

      Image1.Canvas.Brush.Color := colorLine;
      Image1.Canvas.Pen.Color := colorLine;
      Image1.Canvas.MoveTo(MStart.X, MStart.Y);
      Image1.Canvas.LineTo(X,Y);
      Image1.Canvas.MoveTo(1285-(MStart.X-642), MStart.Y);
      Image1.Canvas.LineTo((1285-(X-642)),Y);
	  end
      end ;
        EndX:=X;
        EndY:=Y;
      Label1.Caption := 'N[' + inttostr(X)+',' + inttostr(Y) + '] = ' + FloatToStr(N[x,y]);
	  tem:=Round(min.Value+(max.Value-min.Value)*((N[x,y]/100)));
	  Label4.Caption :='Temp. ='+inttostr(tem);
      Label1.Refresh;
	   Label4.Refresh;
end;

procedure TForm1.WaterFlowCheckClick(Sender: TObject);
begin
        {If WaterFlowCheck.Checked Then
           WaterFlowFlag := 1
        Else
           WaterFlowFlag := 0;    }
end;

end.
